home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
aed243a.zip
/
AED243.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-06-10
|
46KB
|
1,439 lines
'*
'* ANSIED v2.43a
'*---------------------------------------------------------------------------
'* Full Screen Text Editor for RBBS-PC
'* QuickBASIC v4.5 Standalone Version
'* 06-10-90
'*
'* v2.1xx ... made it work with RBBS v17
'* v2.2 ... fixed some inconsistincies in the code as to # of lines in msg.
'* Some of the code thought 99 was length, some thought 100.
'* v2.3 .. let it work with quoted reply. No more REDIM of ZOutTxt$
'* v2.4 .. removed tabs, margins code to be smaller
'* v2.41.. fixed bug with loss of bold attribute occasionally
'* v2.42.. made it work as a v17.3 subroutine. Added block delete.
'* v2.43.. Added to: and from:. Made cursor keys work locally.
'* v2.43a.... Stupid little bugs fixed
'*
'* Returns:
'* ZSubParm = 1 - Save Message
'* = 2 - Abort Message
'* = -1 - Dropped Carrier
'* = -2 - Sleep Disconnect
'*
'* Compile with:
'* BC C:\RBBSARCS\AED243.BAS /O/T/C:512;
'*
DECLARE SUB Ansied (T$, S$, L%)
DECLARE SUB ClearScreen ()
DECLARE SUB UpdateStatusLine (How%)
DECLARE SUB MoveCursor (NewRow%, NewCol%)
DECLARE SUB UnString (WasL$, BadString$)
DECLARE SUB UpdateScreen ()
DECLARE SUB Getch (YY$)
DECLARE SUB SaveCursor (Row%, Col%)
DECLARE SUB DisplayMainMenu ()
DECLARE SUB ClearMainMenu ()
DECLARE SUB PutScreen (YY$, Colour%, Bold%)
DECLARE SUB ExecuteMainMenuCommand (CMD$)
DECLARE SUB DeleteCurrentLine (Index%)
DECLARE SUB BackspChar ()
DECLARE SUB CarrRetKey ()
DECLARE SUB NormalChar (YY$)
DECLARE SUB EraseToEOL (LineNumber%, ColNumber%)
DECLARE SUB FindWrap (YY$, WhereToWrap%)
DECLARE SUB Ungetch (X%)
DECLARE SUB DoneWithMsg ()
DECLARE SUB HelpMe ()
DECLARE SUB ReformText (Justify%)
DECLARE SUB LastParaLine (I%, LastLine%, Result%)
DECLARE SUB RightTrim (YY$)
DECLARE SUB NameCaps (YY$)
DECLARE SUB Carrier ()
DECLARE SUB QuickTput (YY$, NumReturns%)
DECLARE SUB Tput ()
DECLARE SUB FindFKey ()
DECLARE SUB GetCom (YY$)
DECLARE SUB UpdtCalr (YY$, Z%)
DECLARE SUB EofComm (Char%)
DECLARE SUB BufFile (Filename$, Z%)
DECLARE SUB CheckTime (LogoffTime!, Remain!, Z%)
DECLARE SUB Line25 ()
DECLARE SUB ColorPrompt (YY$)
' $INCLUDE: 'RBBS-VAR.MOD'
100 CONST ColorRset = 0
CONST RedFore = 31
CONST GreenFore = 32
CONST YellowFore = 33
CONST BlueFore = 34
CONST MagentaFore = 35
CONST CyanFore = 36
CONST WhiteFore = 37
CONST BlueBack = 44
110 CONST ESCKey = 27
CONST BackspKey = 8
CONST OtherBackspKey = 127
CONST CarrRet = 13
CONST ReformTextKey = 2 ' Ctrl-B
CONST EndSessionKey = 11 ' Ctrl-K
CONST HelpKey = 14 ' Ctrl-N
CONST ReflowTextKey = 15 ' Ctrl-O
CONST RepaintKey = 16 ' Ctrl-P
CONST ToggleINSKey = 22 ' Ctrl-V
CONST LineUpKey = 5 ' Ctrl-E
CONST LineDownKey = 24 ' Ctrl-X
CONST ColLeftKey = 19 ' Ctrl-S
CONST ColRightKey = 4 ' Ctrl-D
CONST WordLeftKey = 1 ' Ctrl-A
CONST WordRightKey = 6 ' Ctrl-F
CONST PageUpKey = 18 ' Ctrl-R
CONST PageDownKey = 3 ' Ctrl-C
CONST HomeKey = 23 ' Ctrl-W
CONST EndKey = 26 ' Ctrl-Z
CONST LineDeleteKey = 25 ' Ctrl-Y
CONST CharDeleteKey = 7 ' Ctrl-G
CONST BlankLine$ = ""
119 CONST Version$ = "v2.43a"
DEFINT A-Z
120 COMMON SHARED /Ansied/ CurrentRow, CurrentCol, TopLine
COMMON SHARED /Ansied/ OldColour, IsBold, InsertMode
COMMON SHARED /Ansied/ SoftSpace$, InsOvwPosition
COMMON SHARED /Ansied/ BlockDelActive, MsgLockLines
COMMON SHARED /Ansied/ BlockLine1, BlockLine2
COMMON SHARED /Ansied/ MsgTo$, MsgSubj$
'*
'* Standalone Main Program
'*
DIM ZOutTxt$(100)
ZFalse = 0
ZTrue = NOT ZFalse
ZEmphasizeOff$ = "
"
ZLocalUser = ZTrue
ZLinesInMsg = 56
ZRightMargin = 40
ZMaxMsgLines = 60
FOR I = 4 TO ZLinesInMsg
ZOutTxt$(I) = "> This is line number" + STR$(I)
NEXT
ZOutTxt$(1) = "* Locked Message Line 1 *"
ZOutTxt$(2) = "* Locked Message Line 2 *"
CALL Ansied("Mike Zakharoff", "(R)New Fullscreen Editor", 2)
END
'* AnsiEd
'*----------------------------------------------------------------------------
'* Main full-screen editor routine
'*
'*
SUB Ansied (T$, S$, L%) STATIC
'*
'* ZworkAra$() holds what's currently on the user's screen.
'* 24 Lines: ZWorkAra$(1) = Menu, Bottom Line = "Line 25"
'*
500 REDIM ZWorkAra$(24)
'*
'* TopLine is the index into the ZOutTxt$() array that
'* corresponds to the top of the displayed image, i.e.
'* what's on line 2 of the user's screen.
'*
'* 1,12,23,34,45,56,78
'*
TopLine = 1
SoftSpace$ = CHR$(250)
InsertMode = ZTrue
ZLineFeed$ = CHR$(10)
OldColour = 0
Bold = ZFalse
IsBold = 99
BlockDelActive = ZFalse
CurrentCol = 0
CurrentRow = 0
MsgLockLines = L
MsgTo$ = T$
CALL NameCaps(MsgTo$)
MsgSubj$ = S$
ZOutTxt$ = ""
IF LEFT$(MsgSubj$, 3) = "(R)" THEN
ZOutTxt$ = "(R)"
MsgSubj$ = MID$(MsgSubj$, 4)
END IF
CALL NameCaps(MsgSubj$)
MsgSubj$ = ZOutTxt$ + MsgSubj$
'*
'* Initialize the screen array as all blanks
'*
510 FOR I = 3 TO 24
ZWorkAra$(I) = BlankLine$
NEXT I
'*
'* Initialize the screen
'*
CALL ClearScreen
CALL UpdateStatusLine(1)
CALL MoveCursor(3, 1)
'*
'* Remove ANSI sequences from the quoted lines
'*
IF ZLinesInMsg > 88 THEN
ZLinesInMsg = 88
END IF
IF ZMaxMsgLines > 98 THEN
ZMaxMsgLines = 98
END IF
IF ZLinesInMsg > ZMaxMsgLines THEN
ZLinesInMsg = ZMaxMsgLines
END IF
FOR I = ZLinesInMsg + 1 TO 99
ZOutTxt$(I) = BlankLine$
NEXT
IF ZLinesInMsg <> 0 THEN
FOR I = 1 TO ZLinesInMsg
CALL UnString(ZOutTxt$(I), "")
NEXT
I! = ZLinesInMsg / 11
J = FIX(I!)
IF J = I! THEN
J = J - 1
END IF
TopLine = J * 11 + 1
J = ZLinesInMsg - TopLine
CALL MoveCursor(J + 5, 1)
END IF
CALL UpdateScreen
'*
'* Run the Editor
'*
520 WHILE ZTrue
CALL Carrier: GOSUB 740
CALL Getch(B$): GOSUB 740
KeyPressed = ASC(B$)
Index = CurrentRow + TopLine - 3
IF BlockDelActive OR Index <= MsgLockLines OR Index > ZMaxMsgLines THEN
530 SELECT CASE KeyPressed
CASE CarrRet
IF BlockDelActive THEN
BlockDelActive = ZFalse
BlockLine2 = Index
IF Index < BlockLine1 THEN
BlockLine2 = BlockLine1
BlockLine1 = Index
END IF
IF BlockLine1 <= MsgLockLines THEN
BlockLine1 = MsgLockLines + 1
END IF
IF BlockLine2 > ZMaxMsgLines THEN
BlockLine2 = ZMaxMsgLines
END IF
K = 0
FOR I = BlockLine2 + 1 TO 99
ZOutTxt$(BlockLine1 + K) = ZOutTxt$(I)
K = K + 1
NEXT I
WHILE BlockLine1 + K <= 99
ZOutTxt$(BlockLine1 + K) = BlankLine$
K = K + 1
WEND
CALL UpdateScreen
CALL UpdateStatusLine(2)
CALL MoveCursor(RowSave, ColSave)
END IF
KeyPressed = 255
540 CASE ESCKey
IF BlockDelActive THEN
BlockDelActive = ZFalse
CALL SaveCursor(RowSave, ColSave)
CALL UpdateStatusLine(2)
CALL MoveCursor(RowSave, ColSave)
KeyPressed = 255
END IF
CASE LineUpKey, LineDownKey, PageDownKey, PageUpKey
'*
'* Up and Down get passed on
'*
CASE ELSE
'*
'* Ignore the key
'*
KeyPressed = 255
END SELECT
END IF
'*
'* Look for an ANSI escape sequence after an ESC
'*
550 IF KeyPressed = ESCKey THEN
CALL Getch(B$): GOSUB 740
IF B$ = "[" THEN ' ANSI sequence
CALL Getch(B$): GOSUB 740
IF B$ = "C" THEN
KeyPressed = ColRightKey
ELSEIF B$ = "D" THEN
KeyPressed = ColLeftKey
ELSEIF B$ = "A" THEN
KeyPressed = LineUpKey
ELSEIF B$ = "B" THEN
KeyPressed = LineDownKey
END IF
END IF
END IF
560 SELECT CASE KeyPressed
CASE ESCKey
'*
'* User wants to see main menu
'*
CALL SaveCursor(RowSave, ColSave)
CALL DisplayMainMenu
CALL MoveCursor(RowSave, ColSave)
KeyPressed = 255: B$ = ""
WHILE KeyPressed <> ESCKey
CALL Getch(B$): GOSUB 740
B$ = UCASE$(B$)
KeyPressed = ASC(B$)
IF KeyPressed = CarrRet THEN
B$ = "H"
END IF
I = INSTR("HJREIPB" + CHR$(ESCKey), B$)
IF I = 7 THEN
BlockDelActive = ZTrue
BlockLine1 = RowSave + TopLine - 3
CALL ClearMainMenu
CALL QuickTput(ZEmphasizeOff$, 0)
CALL PutScreen("Block Delete: Move cursor to last line to delete and press ENTER ESC Quits", 99, ZFalse)
CALL MoveCursor(RowSave, ColSave)
BlockLine2 = 0
KeyPressed = ESCKey
ELSEIF I <> 0 THEN
CALL ExecuteMainMenuCommand(B$): GOSUB 740
KeyPressed = ESCKey
END IF
WEND
CALL MoveCursor(RowSave, ColSave)
570 CASE LineUpKey
'*
'* Move the current cursor position up one line
'*
IF CurrentRow > 3 THEN
CALL MoveCursor(CurrentRow - 1, CurrentCol)
ELSE
IF TopLine <> 1 THEN
TopLine = TopLine - 11
CALL MoveCursor(CurrentRow + 10, CurrentCol)
CALL UpdateScreen
END IF
END IF
580 CASE LineDownKey
'*
'* Move the current cursor position down one line
'*
IF CurrentRow < 24 THEN
CALL MoveCursor(CurrentRow + 1, CurrentCol)
ELSE
IF NOT TopLine = 78 THEN
TopLine = TopLine + 11
CALL MoveCursor(CurrentRow - 10, CurrentCol)
CALL UpdateScreen
END IF
END IF
590 CASE ColLeftKey
'*
'* Move the current cursor left one column
'*
IF CurrentCol > 1 THEN
CALL MoveCursor(CurrentRow, CurrentCol - 1)
END IF
600 CASE ColRightKey
'*
'* Move the current cursor right one column
'*
IF CurrentCol < 79 THEN
CALL MoveCursor(CurrentRow, CurrentCol + 1)
END IF
610 CASE WordRightKey
'*
'* Move the current cursor right one word
'*
FOR I = CurrentCol TO LEN(ZOutTxt$(Index)) - 1
YY$ = MID$(ZOutTxt$(Index), I, 1)
ZZ$ = MID$(ZOutTxt$(Index), I + 1, 1)
IF (YY$ = " " OR YY$ = SoftSpace$) AND ZZ$ <> " " AND ZZ$ <> SoftSpace$ THEN
NewCol = I + 1
IF NewCol > 79 THEN
NewCol = 79
END IF
CALL MoveCursor(CurrentRow, NewCol)
EXIT FOR
END IF
NEXT I
620 CASE WordLeftKey
'*
'* Move the current cursor left one word
'*
Found = ZFalse
FOR I = CurrentCol - 1 TO 2 STEP -1
ZZ$ = MID$(ZOutTxt$(Index), I, 1)
YY$ = MID$(ZOutTxt$(Index), I - 1, 1)
IF (YY$ = " " OR YY$ = SoftSpace$) AND ZZ$ <> " " AND ZZ$ <> SoftSpace$ THEN
NewCol = I
CALL MoveCursor(CurrentRow, NewCol)
Found = ZTrue
EXIT FOR
END IF
NEXT I
IF NOT Found THEN
CALL MoveCursor(CurrentRow, 1)
END IF
630 CASE HomeKey
'*
'* Move cursor to the start of the line
'*
CALL MoveCursor(CurrentRow, 1)
640 CASE EndKey
'*
'* Move cursor to the end of the line
'*
IF ZOutTxt$(Index) = STRING$(79, 250) THEN
NewCol = 1
ELSE
NewCol = 0
FOR I = LEN(ZOutTxt$(Index)) TO 1 STEP -1
IF MID$(ZOutTxt$(Index), I, 1) <> SoftSpace$ THEN
NewCol = I + 1
EXIT FOR
END IF
NEXT I
IF NewCol > 79 THEN
NewCol = 79
ELSEIF NewCol < 1 THEN
NewCol = 1
END IF
END IF
CALL MoveCursor(CurrentRow, NewCol)
650 CASE PageDownKey
'*
'* Move the display one page down
'*
TopLine = TopLine + 22
IF TopLine > 78 THEN
TopLine = 78
END IF
CALL UpdateScreen
660 CASE PageUpKey
'*
'* Move the display one page up
'*
TopLine = TopLine - 22
IF TopLine < 1 THEN
TopLine = 1
END IF
CALL UpdateScreen
670 CASE LineDeleteKey
'*
'* Delete the current line in the file
'*
CALL SaveCursor(RowSave, ColSave)
CALL DeleteCurrentLine(Index)
CALL MoveCursor(RowSave, ColSave)
680 CASE CharDeleteKey
'*
'* Delete the current character
'*
IF CurrentCol <= LEN(ZOutTxt$(Index)) THEN
CALL MoveCursor(CurrentRow, CurrentCol + 1)
CALL BackspChar
END IF
690 CASE BackspKey, OtherBackspKey
'*
'* Back up one character and destroy it
'*
CALL BackspChar
700 CASE CarrRet
'*
'* Move to the next line, left column
'*
IF NOT Index >= ZMaxMsgLines THEN
CALL CarrRetKey
END IF
710 CASE HelpKey, ReformTextKey, ReflowTextKey, EndSessionKey, ToggleINSKey, RepaintKey
'*
'* Execute a main menu command
'*
'* 1234567890123456789012
YY$ = MID$(" J E HRP I", KeyPressed, 1)
CALL SaveCursor(RowSave, ColSave)
CALL ExecuteMainMenuCommand(YY$): GOSUB 740
CALL MoveCursor(RowSave, ColSave)
CASE IS > 127, IS < 32
'*
'* Ignore characters above 127 or below 32
'*
720 CASE ELSE
'*
'* Input was a normal character
'*
CALL NormalChar(B$)
END SELECT
WEND
730 REDIM ZWorkAra$(13)
EXIT SUB
'*
'* Test ZSubParam and Exit ANSIED if the carrier dropped
'*
740 IF ZSubParm <> 0 THEN
GOTO 730
END IF
RETURN
END SUB ' Sub AnsiEd
'* BackspChar()
'*----------------------------------------------------------------------------
'* This routine handles the user entering the backspace key
'*
'*
SUB BackspChar STATIC
1200 CALL SaveCursor(RowSave, ColSave)
Index = TopLine + CurrentRow - 3
IF Index = MsgLockLines + 1 AND CurrentCol = 1 THEN
EXIT SUB
END IF
AtEndOfLine = CurrentCol > LEN(ZOutTxt$(Index))
1210 IF CurrentCol > 1 THEN
ZOutTxt$(Index) = LEFT$(ZOutTxt$(Index), CurrentCol - 2) + MID$(ZOutTxt$(Index), CurrentCol)
CALL EraseToEOL(CurrentRow, CurrentCol - 1)
IF NOT AtEndOfLine THEN
YY$ = MID$(ZOutTxt$(Index), ColSave - 1)
CALL MoveCursor(RowSave, ColSave - 1)
CALL PutScreen(YY$, YellowFore, ZTrue)
END IF
CALL MoveCursor(RowSave, ColSave - 1)
ZWorkAra$(CurrentRow) = ZOutTxt$(Index)
ELSEIF LEN(ZOutTxt$(Index - 1)) >= ZRightMargin THEN
'*
'* Do nothing
'*
1220 ELSE
NewCol = LEN(ZOutTxt$(Index - 1)) + 1
YY$ = ZOutTxt$(Index)
CALL UnString(YY$, SoftSpace$)
ZOutTxt$(Index - 1) = ZOutTxt$(Index - 1) + YY$
IF LEN(ZOutTxt$(Index - 1)) < ZRightMargin THEN
CALL DeleteCurrentLine(Index)
1230 ELSE
CALL FindWrap(LEFT$(ZOutTxt$(Index - 1), ZRightMargin + 1), I)
IF I = 0 OR I = 1 THEN
I = ZRightMargin
END IF
ZOutTxt$(Index) = MID$(ZOutTxt$(Index - 1), I + 1)
ZOutTxt$(Index - 1) = LEFT$(ZOutTxt$(Index - 1), I)
END IF
IF RowSave > 3 THEN
CALL MoveCursor(RowSave - 1, NewCol)
CALL UpdateScreen
ELSE
CALL MoveCursor(RowSave, NewCol)
CALL Ungetch(LineUpKey)
END IF
END IF
END SUB
SUB BufFile (Filename$, Z) STATIC
END SUB
SUB Carrier STATIC
ZSubParm = 0
END SUB
'* CarrRetKey()
'*----------------------------------------------------------------------------
'* This routine handles carriage returns entered in the file
'*
'*
SUB CarrRetKey STATIC
1300 Index = CurrentRow + TopLine - 3
IF Index >= 99 THEN
EXIT SUB
END IF
IF InsertMode THEN ' Insert a new line
FOR I = 98 TO Index + 1 STEP -1
ZOutTxt$(I + 1) = ZOutTxt$(I)
NEXT I
IF LEN(ZOutTxt$(Index)) >= CurrentCol THEN
ZOutTxt$(Index + 1) = MID$(ZOutTxt$(Index), CurrentCol)
ZOutTxt$(Index) = LEFT$(ZOutTxt$(Index), CurrentCol - 1)
ELSE
ZOutTxt$(Index + 1) = BlankLine$
END IF
CALL UpdateScreen
END IF
IF CurrentRow < 24 THEN
CALL MoveCursor(CurrentRow + 1, 1)
ELSE
CALL MoveCursor(CurrentRow, 1)
CALL Ungetch(LineDownKey)
END IF
END SUB
SUB CheckTime (LogoffTime!, Remain!, Z) STATIC
Remain! = 1
END SUB
'* ClearMainMenu()
'*----------------------------------------------------------------------------
'* This routine clears the main menu from the top line
'*
'*
SUB ClearMainMenu STATIC
1400 CALL EraseToEOL(1, 1)
CALL MoveCursor(1, 1)
END SUB
'* ClearScreen()
'*----------------------------------------------------------------------------
'* This routine clears the screen and moves the cursor to row 2, col 1
'*
'*
SUB ClearScreen STATIC
1500 FOR I = 1 TO 23
ZWorkAra$(I) = BlankLine$
NEXT I
CALL QuickTput("H", 0) ' clear screen, column 1, row 3
ZSubParm = 2
CALL Line25
ZSubParm = 0
CurrentCol = 1
CurrentRow = 3
IsBold = 99
END SUB
SUB ColorPrompt (YY$)
CALL QuickTput(ZEmphasizeOff$, 0)
END SUB
'* DeleteCurrentLine()
'*----------------------------------------------------------------------------
'* This routine deletes the current line on the screen and in the array
'* ZOutTxt$, and moves the next lower line up one It then repaints the
'* affected portion of the screen (from the deleted line down)
'*
'*
SUB DeleteCurrentLine (Index%) STATIC
1600 FOR I = Index% TO 98
ZOutTxt$(I) = ZOutTxt$(I + 1)
NEXT I
ZOutTxt$(99) = BlankLine$
CALL UpdateScreen
END SUB
'* DisplayMainMenu()
'*----------------------------------------------------------------------------
'* This routine displays the main menu on the top line
'*
'*
SUB DisplayMainMenu STATIC
1700 CALL MoveCursor(1, 1)
CALL QuickTput(ZEmphasizeOff$, 0)
YY$ = " [H]elp E)nd R)eflow J)ustify I)ns/Ovw P)aint B)lock Delete ESC Quits"
YY$ = YY$ + SPACE$(79 - LEN(YY$))
ZHiLiteOff = ZFalse
CALL ColorPrompt(YY$)
CALL PutScreen(YY$, 99, ZTrue)
IsBold = 99
END SUB
'* DoneWithMsg()
'*----------------------------------------------------------------------------
'* This routine is called to save or abort the message
'*
'*
SUB DoneWithMsg STATIC
1800 CALL SaveCursor(RowSave, ColSave)
CALL ClearMainMenu
CALL QuickTput(ZEmphasizeOff$, 0)
YY$ = "End Message: S)ave, A)bort, or [C]ontinue? "
ZHiLiteOff = ZFalse
CALL ColorPrompt(YY$)
CALL PutScreen(YY$, 99, ZTrue)
B$ = " "
WHILE INSTR("SAC" + CHR$(ESCKey) + CHR$(CarrRet), B$) = 0
CALL Getch(B$)
IF ZSubParm <> 0 THEN
EXIT SUB
END IF
B$ = UCASE$(B$)
WEND
1810 SELECT CASE B$
CASE "S" ' Save Message
CALL ClearScreen
'*
'* Remove trailing blank lines from the message
'*
EndOfMsg = ZMaxMsgLines
FOR I = ZMaxMsgLines TO 1 STEP -1
IF ZOutTxt$(I) <> BlankLine$ THEN
EndOfMsg = I
EXIT FOR
END IF
NEXT I
IF I = 0 THEN
EndOfMsg = 1
END IF
FOR I = 1 TO EndOfMsg
J = INSTR(ZOutTxt$(I), SoftSpace$)
WHILE J <> 0
MID$(ZOutTxt$(I), J, 1) = " "
J = INSTR(ZOutTxt$(I), SoftSpace$)
WEND
NEXT I
FOR I = EndOfMsg TO 1 STEP -1
ZOutTxt$ = RTRIM$(ZOutTxt$)
IF ZOutTxt$(I) <> BlankLine$ THEN
EndOfMsg = I
EXIT FOR
END IF
NEXT I
ZLinesInMsg = EndOfMsg
CALL QuickTput(ZEmphasizeOff$, 0)
ZSubParm = 1
1820 CASE "A"
CALL ClearMainMenu
CALL QuickTput(ZEmphasizeOff$, 0)
YY$ = "Abort: Are You Sure (Y)es,[N]o)? "
ZHiLiteOff = ZFalse
CALL ColorPrompt(YY$)
CALL PutScreen(YY$, 99, ZTrue)
CALL Getch(B$)
IF ZSubParm <> 0 THEN
B$ = "Y"
END IF
IF UCASE$(B$) = "Y" THEN
CALL ClearScreen
CALL QuickTput(ZEmphasizeOff$, 0)
ZSubParm = 2
END IF
END SELECT
END SUB
SUB EofComm (Char%) STATIC
Char% = -1
END SUB
'* EraseToEOL()
'*----------------------------------------------------------------------------
'* This routine clears from a position to to the end of that line
'*
'*
SUB EraseToEOL (LineNumber, ColNumber) STATIC
1900 CALL SaveCursor(RowSave, ColSave)
CALL MoveCursor(LineNumber, ColNumber)
CALL QuickTput("", 0)
CALL MoveCursor(RowSave, ColSave)
END SUB
'* ExecuteMainMenuCommand()
'*----------------------------------------------------------------------------
'* This routine executes the passed main menu command
'*
'*
SUB ExecuteMainMenuCommand (CMD$) STATIC
2000 ZSubParm = 0
SELECT CASE CMD$
CASE "H"
CALL HelpMe
CASE "E"
CALL DoneWithMsg
CASE "P"
CALL ClearScreen
CALL UpdateScreen
CASE "I"
InsertMode = NOT InsertMode
CASE "R"
CALL ReformText(ZFalse)
CASE "J"
CALL ReformText(ZTrue)
END SELECT
IsBold = 99
IF ZSubParm = 0 THEN
CALL ClearMainMenu
CALL UpdateStatusLine(1)
END IF
END SUB
SUB FindFKey
ZSubParm = 0
ZKeyPressed$ = ""
END SUB
'* FindWrap()
'*----------------------------------------------------------------------------
'* This routine finds a place in the string yy$ that could be used as a
'* place to wrap the line WhereToWrap should be the last position that
'* remains in the line, ie
'* set currentline$ = left$(yy$,wheretowrap)
'* nextline$ = mid$ (yy$,wheretowrap+1)
'*
'*
SUB FindWrap (YY$, WhereToWrap) STATIC
2100 I = LEN(YY$)
XX$ = " " + SoftSpace$
'*
'* Back over "False hits"
'*
ZZ$ = MID$(YY$, I, 1)
WHILE INSTR(XX$, ZZ$) <> 0 AND I <> 1
I = I - 1
ZZ$ = MID$(YY$, I, 1)
WEND
WHILE INSTR(XX$, ZZ$) = 0 AND I <> 1
I = I - 1
ZZ$ = MID$(YY$, I, 1)
WEND
WhereToWrap = I
END SUB
'* Getch()
'*----------------------------------------------------------------------------
'* This routine reads a character from the user into YY$
'*
'*
SUB Getch (YY$) STATIC
2200 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
CALL Carrier
YY$ = ""
WHILE ZSubParm <> -1 AND ZSubParm <> -2 AND YY$ = ""
ZSubParm = 0
IF LEN(ZCommportStack$) > 0 THEN
YY$ = LEFT$(ZCommportStack$, 1)
ZCommportStack$ = MID$(ZCommportStack$, 2)
ELSE
IF ZLocalUser THEN
YY$ = INKEY$
IF LEN(YY$) = 2 THEN
KeyPressed = ASC(RIGHT$(YY$, 1))
YY$ = ""
SELECT CASE KeyPressed
CASE 82 ' Insert
YY$ = CHR$(ToggleINSKey)
CASE 83 ' Delete
YY$ = CHR$(CharDeleteKey)
CASE 71 ' Home
YY$ = CHR$(HomeKey)
CASE 73 ' PgUp
YY$ = CHR$(PageUpKey)
CASE 72 ' Up Arrow
YY$ = CHR$(LineUpKey)
CASE 80 ' Down Arrow
YY$ = CHR$(LineDownKey)
CASE 81 ' PgDn
YY$ = CHR$(PageDownKey)
CASE 75 ' Left Arrow
YY$ = CHR$(ColLeftKey)
CASE 77 ' Right Arrow
YY$ = CHR$(ColRightKey)
CASE 115 ' Ctrl-Left Arrow
YY$ = CHR$(WordLeftKey)
CASE 116 ' Ctrl-Right Arrow
YY$ = CHR$(WordRightKey)
CASE 79 ' End
YY$ = CHR$(EndKey)
END SELECT
END IF
ELSE
CALL FindFKey
IF ZSubParm >= 0 THEN
YY$ = ZKeyPressed$
IF YY$ = "" THEN
CALL EofComm(Char%)
IF Char% = -1 THEN
CALL CheckTime(ZAutoLogoff!, Remain!, 1)
IF Remain! < 0 THEN
CALL UpdtCalr("Sleep disconnect", 1)
ZSubParm = -2
ZNo = ZTrue
ZSleepDisconnect = ZTrue
END IF
ELSE
CALL Carrier
IF ZSubParm <> -1 THEN
ZSubParm = 0
CALL GetCom(YY$)
END IF
END IF
END IF
END IF
END IF
END IF
WEND
END SUB
SUB GetCom (YY$)
END SUB
'* HelpMe()
'*----------------------------------------------------------------------------
'* This routine provides on-line help for the user
'*
'*
SUB HelpMe STATIC
2300 CALL SaveCursor(RowSave, ColSave)
CALL ClearScreen
CALL QuickTput(ZEmphasizeOff$, 0)
CALL BufFile(ZHelpPath$ + "ANSIED" + ZHelpExtension$, X)
OldColour = 0
IsBold = 99
CALL ClearScreen
FOR I = 3 TO 24
ZWorkAra$(I) = BlankLine$
NEXT I
CALL UpdateScreen
CALL MoveCursor(ColSave, RowSave)
END SUB
'* LastParaLine()
'*----------------------------------------------------------------------------
'* This routine returns ZTrue if ZOutTxt$(I) is the last line
'* in a paragraph
'*
'*
SUB LastParaLine (I, LastLine, Result) STATIC
2400 Result = ZFalse
IF I = LastLine OR I >= ZMaxMsgLines THEN
Result = ZTrue
ELSE
YY$ = ZOutTxt$(I)
J = INSTR(YY$, ">")
IF J = 0 THEN
J = 6
END IF
IF J < 5 THEN
Result = ZTrue
ELSEIF YY$ = BlankLine$ THEN
Result = ZTrue
ELSE
IF ZOutTxt$(I + 1) = BlankLine$ THEN
Result = ZTrue
ELSEIF LEFT$(ZOutTxt$(I + 1), 1) = " " THEN
Result = ZTrue
ELSE
K = INSTR(ZOutTxt$(I + 1), ">")
IF K <> 0 AND K < 5 THEN
Result = ZTrue
END IF
END IF
END IF
END IF
END SUB
SUB Line25 STATIC
END SUB
'* MoveCursor()
'*----------------------------------------------------------------------------
'* This routine moves the cursor to the position spec'd by newcol and
'* newrow and tries to do it with the minimum number of Ansi characters
'*
'*
SUB MoveCursor (NewRow, NewCol) STATIC
2500 IF CurrentRow = NewRow AND CurrentCol = NewCol THEN
EXIT SUB
ELSEIF NewCol = 0 AND NewRow = 0 THEN
EXIT SUB
ELSEIF NewCol = 1 AND NewRow = 1 THEN
YY$ = "f"
ELSEIF NewCol <> CurrentCol AND NewRow <> CurrentRow THEN
YY$ = "" + MID$(STR$(NewRow), 2) + ";" + MID$(STR$(NewCol), 2) + "f"
ELSE
IF CurrentCol = NewCol THEN ' Just the row has changed
I = CurrentRow - NewRow
C$ = "A" ' A=Up, B=Down
ELSE ' Just the column changed
I = NewCol - CurrentCol
C$ = "C" ' C=Left, D=Right
END IF
'*
'* Adjust the direction of the cursor
'*
IF I < 0 THEN
I = -I
C$ = CHR$(ASC(C$) + 1)
END IF
YY$ = ""
IF I > 1 THEN
YY$ = YY$ + MID$(STR$(I), 2)
END IF
YY$ = YY$ + C$
END IF
CALL QuickTput(YY$, 0)
ZSubParm = 0
CurrentRow = NewRow
CurrentCol = NewCol
END SUB
SUB NameCaps (YY$)
END SUB
'* NormalChar()
'*----------------------------------------------------------------------------
'* This routine handles 'normal' characters entered into the message
'*
'*
SUB NormalChar (YY$) STATIC
2600 CALL SaveCursor(RowSave, ColSave)
Index = CurrentRow + TopLine - 3
CurrentLineBlank = (ZOutTxt$(Index) = BlankLine$)
LML = LEN(ZOutTxt$(Index))
IF CurrentCol > 79 THEN
EXIT SUB
END IF
AtEndOfLine = ZFalse
IF CurrentCol > LML THEN
ZOutTxt$(Index) = ZOutTxt$(Index) + SPACE$(CurrentCol - LML)
ZWorkAra$(CurrentRow) = ZWorkAra$(CurrentRow) + SPACE$(CurrentCol - LML)
LML = LEN(ZOutTxt$(Index))
AtEndOfLine = ZTrue
END IF
2610 IF (CurrentCol <= ZRightMargin AND AtEndOfLine) OR (CurrentCol <= ZRightMargin AND NOT InsertMode) THEN
'*
'* Single character changed
'*
MID$(ZOutTxt$(Index), CurrentCol, 1) = YY$
MID$(ZWorkAra$(CurrentRow), CurrentCol, 1) = YY$
CALL PutScreen(YY$, YellowFore, ZTrue)
2620 ELSEIF (NOT AtEndOfLine AND InsertMode AND CurrentCol <= ZRightMargin AND LML <= ZRightMargin) THEN
'*
'* Have to rewrite the screen from the current pos forward
'*
ZOutTxt$(Index) = LEFT$(ZOutTxt$(Index), CurrentCol - 1) + YY$ + MID$(ZOutTxt$(Index), CurrentCol)
ZWorkAra$(CurrentRow) = ZOutTxt$(Index)
CALL EraseToEOL(CurrentRow, CurrentCol)
ZZ$ = MID$(ZWorkAra$(CurrentRow), CurrentCol)
CALL PutScreen(ZZ$, YellowFore, ZTrue)
CALL MoveCursor(RowSave, ColSave + 1)
2630 ELSE
'*
'* Wrap the end of the line
'*
IF NOT AtEndOfLine THEN
ZOutTxt$(Index) = LEFT$(ZOutTxt$(Index), CurrentCol - 1) + YY$ + MID$(ZOutTxt$(Index), CurrentCol)
LML = LML + 1
ELSE
MID$(ZOutTxt$(Index), CurrentCol, 1) = YY$
END IF
CALL FindWrap(ZOutTxt$(Index), I)
IF I = 0 OR I = 1 THEN
I = ZRightMargin
END IF
ZZ$ = MID$(ZOutTxt$(Index), (I + 1))
CALL RightTrim(ZZ$)
ZOutTxt$(Index) = LEFT$(ZOutTxt$(Index), I)
' add to the beginning of a new line
IF Index <= 98 THEN
Index = Index + 1
END IF
FOR J = 98 TO Index STEP -1
ZOutTxt$(J + 1) = ZOutTxt$(J)
NEXT J
ZOutTxt$(Index) = ZZ$
CALL EraseToEOL(CurrentRow, I + 1) ' do the "easy" line
ZWorkAra$(CurrentRow) = ZOutTxt$(Index)
CALL UpdateScreen
IF (ColSave > I) THEN
NewCol = ColSave - I + 1
IF RowSave <> 24 THEN
CALL MoveCursor(RowSave + 1, NewCol)
ELSE
CALL MoveCursor(RowSave, NewCol)
CALL Ungetch(LineDownKey)
END IF
ELSE
CALL MoveCursor(RowSave, ColSave + 1)
END IF
END IF
END SUB
'* PutScreen()
'*----------------------------------------------------------------------------
'* This routine writes YY$ to the user in the color and
'* intensity specified
'*
'*
SUB PutScreen (YY$, Colour, Bold) STATIC
2800 ZZ$ = ""
IF Colour <> 99 THEN
IF (Colour <> OldColour) OR (Bold <> IsBold) THEN
ZZ$ = ""
IF Bold <> IsBold THEN
IF Bold THEN
ZZ$ = ZZ$ + "1;"
IsBold = ZTrue
ELSE
ZZ$ = ZZ$ + "0;"
IsBold = ZFalse
END IF
END IF
ZZ$ = ZZ$ + MID$(STR$(Colour), 2)
ZZ$ = ZZ$ + "m"
END IF
END IF
ZOutTxt$ = ZZ$ + YY$
IF ZLocalUser THEN
CALL QuickTput(ZOutTxt$, 0)
ELSE
ZSubParm = 4
CALL Tput
ZSubParm = 0
END IF
IF INSTR(YY$, "") = 0 THEN
CurrentCol = CurrentCol + LEN(YY$)
IF CurrentCol > 80 THEN
CurrentCol = 0
CurrentRow = 0
END IF
ELSE
CurrentRow = 0
CurrentCol = 0
END IF
OldColour = Colour
Colour = 99
END SUB
SUB QuickTput (YY$, NumReturns) STATIC
OPEN "Cons:" FOR OUTPUT AS #3
PRINT #3, YY$;
FOR I = 1 TO NumReturns
PRINT #3,
NEXT
CLOSE 3
END SUB
SUB QuickTput1 (YY$) STATIC
CALL QuickTput(YY$, 1)
END SUB
'* ReformText()
'*----------------------------------------------------------------------------
'* This routine reflows the text to the current margins. Optionally,
'* it right justifies all lines by adding "soft spaces"
'*
'*
SUB ReformText (Justify%) STATIC
2900 DIM SpacePlace(80)
CALL ClearMainMenu
CALL PutScreen("Reformatting... Please Wait.", WhiteFore, ZTrue)
LastLine = 1
FOR I = ZMaxMsgLines TO 1 STEP -1
IF ZOutTxt$(I) <> BlankLine$ THEN
LastLine = I
EXIT FOR
END IF
NEXT
I = MsgLockLines + 1 ' Read index
J = MsgLockLines + 1 ' Write index
'*
'* Reflow the text to the maximum on a line
'*
DO WHILE I <= LastLine
ZOutTxt$ = ""
DO WHILE 1
YY$ = ZOutTxt$(I)
CALL UnString(YY$, SoftSpace$)
IF ZOutTxt$ <> "" AND RIGHT$(ZOutTxt$, 1) <> " " THEN
ZOutTxt$ = ZOutTxt$ + " "
END IF
ZOutTxt$ = ZOutTxt$ + YY$
CALL LastParaLine(I, LastLine, Z)
IF LEN(ZOutTxt$) > ZRightMargin OR Z THEN
IF LEN(ZOutTxt$) > ZRightMargin THEN
CALL FindWrap(LEFT$(ZOutTxt$, ZRightMargin + 1), K)
IF K = 0 OR K = 1 THEN K = ZRightMargin
ZOutTxt$(J) = LEFT$(ZOutTxt$, K)
IF Z THEN
' Go to the next paragraph
ZOutTxt$(J + 1) = MID$(ZOutTxt$, K + 1)
J = J + 2
I = I + 1
EXIT DO
ELSE
ZOutTxt$(I) = MID$(ZOutTxt$, K + 1)
J = J + 1
EXIT DO
END IF
ELSE ' Z is ZTrue
ZOutTxt$(J) = ZOutTxt$
J = J + 1
I = I + 1
EXIT DO
END IF
ELSE
I = I + 1
END IF
LOOP
LOOP
FOR I = J TO 99
ZOutTxt$(I) = BlankLine$
NEXT
LastLine = J - 1
'*
'* Space out the text on each line
'*
IF Justify% THEN
FOR I = MsgLockLines + 1 TO LastLine
CALL LastParaLine(I, LastLine, Z)
IF Z THEN
ELSE
ZOutTxt$ = ZOutTxt$(I)
ZOutTxt$ = RTRIM$(ZOutTxt$)
'*
'* Skip leading spaces on the line
'*
J = -1
FOR K = 1 TO LEN(ZOutTxt$)
IF MID$(ZOutTxt$, K, 1) <> " " THEN
J = K
EXIT FOR
END IF
NEXT
IF J <> -1 THEN
'*
'* Find out all of the possible places to put spaces
'*
L = 0
M = INSTR(J, ZOutTxt$, " ")
WHILE M <> 0
L = L + 1
SpacePlace(L) = M
M = INSTR(M + 1, ZOutTxt$, " ")
WEND
IF L <> 0 THEN
'*
'* Space out the line. First add a space to the
'* start of the line, then add to the end.
'*
SpacesToAdd = ZRightMargin - LEN(ZOutTxt$)
M = 1
N = L
DoM = ZTrue
WHILE SpacesToAdd <> 0
IF DoM THEN
Place = SpacePlace(M)
M = M + 1
ELSE
Place = SpacePlace(N)
N = N - 1
END IF
DoM = NOT DoM
ZOutTxt$(I) = LEFT$(ZOutTxt$(I), Place) + SoftSpace$ + MID$(ZOutTxt$(I), Place + 1)
SpacesToAdd = SpacesToAdd - 1
FOR P = 1 TO L
IF SpacePlace(P) > Place THEN
SpacePlace(P) = SpacePlace(P) + 1
END IF
NEXT
IF M = N THEN
M = 1
N = L
END IF
WEND
END IF
END IF
END IF
NEXT
END IF
CALL UpdateScreen
END SUB
'* RightTrim()
'*----------------------------------------------------------------------------
'* Removes soft spaces from a string
'*
'*
SUB RightTrim (YY$) STATIC
3000 FOR I = LEN(YY$) TO 1 STEP -1
IF MID$(YY$, I, 1) <> SoftSpace$ THEN
YY$ = LEFT$(YY$, I)
EXIT SUB
END IF
NEXT I
YY$ = ""
END SUB
'* SaveCursor()
'*----------------------------------------------------------------------------
'* This routine saves the current cursor position
'*
'*
SUB SaveCursor (Row%, Col%) STATIC
Row% = CurrentRow
Col% = CurrentCol
END SUB
SUB Tput STATIC
CALL QuickTput(ZOutTxt$, 0)
END SUB
'* UnGetch()
'*----------------------------------------------------------------------------
'* Puts a key in the beginning of the keyboard buffer
'*
'*
SUB Ungetch (X) STATIC
ZCommportStack$ = CHR$(X) + ZCommportStack$
END SUB
'* UnString()
'*----------------------------------------------------------------------------
'* Removes one string from another
'*
'*
SUB UnString (WasL$, BadString$) STATIC
WasI = INSTR(WasL$, BadString$)
WHILE WasI <> 0
WasL$ = LEFT$(WasL$, WasI - 1) + MID$(WasL$, WasI + LEN(BadString$))
WasI = INSTR(WasL$, BadString$)
WEND
END SUB
'* UpdateScreen()
'*----------------------------------------------------------------------------
'* This is one of the most important routines It compares the arrays
'* ZOutTxt$ and ZWorkAra$ and only sends the user the DIFFERENCE between the
'* two within the viewing area In this way all processing can be done on
'* ZOutTxt$ and then the screen is updated to reflect the changes. After the
'* users screen is updated, ZWorkAra$ is changed to reflect what should be
'* on the users' screen The cursor is restored to its original position
'*
'*
SUB UpdateScreen STATIC
3100 CALL SaveCursor(RowSave, ColSave)
FOR I = 3 TO 24
Index = I + TopLine - 3
ScreenLine$ = ZWorkAra$(I)
MessageLine$ = ZOutTxt$(Index)
LML = LEN(MessageLine$)
IF Index = ZMaxMsgLines + 1 THEN
CALL EraseToEOL(I, 1)
CALL MoveCursor(I, 1)
CALL PutScreen("[* End of Message *]", CyanFore, ZFalse)
ZWorkAra$(I) = CHR$(EndKey)
ELSEIF Index > ZMaxMsgLines + 1 THEN
IF ScreenLine$ <> BlankLine$ THEN
CALL EraseToEOL(I, 1)
ZWorkAra$(I) = BlankLine$
END IF
ELSEIF MessageLine$ = ScreenLine$ THEN
'*
'* Screen = What's in message buffer
'*
ELSEIF MessageLine$ = BlankLine$ OR MessageLine$ = SPACE$(LML) THEN
CALL EraseToEOL(I, 1)
ZWorkAra$(I) = MessageLine$
ELSE
CALL MoveCursor(I, 1)
YY$ = MessageLine$
CALL PutScreen(YY$, YellowFore, ZTrue)
CALL EraseToEOL(CurrentRow, CurrentCol)
ZWorkAra$(I) = ZOutTxt$(Index)
END IF
NEXT I
CALL MoveCursor(RowSave, ColSave)
END SUB
'* UpdateStatusLine()
'*-----------------------------------------------------------------------------
'* Rewrites the status line on screen line(s) 1 and 2
'*
'* Input: How% = 1 - Rewrite both lines
'* How% = 2 - Just rewrite top line
'*
SUB UpdateStatusLine (How%) STATIC
3200 YY$ = "ANSIED " + Version$ + " by Tom Collins * Press ESC Twice for Menu *"
YY$ = YY$ + SPACE$(79 - LEN(YY$))
CALL MoveCursor(1, 1)
CALL PutScreen(YY$, BlueFore, ZTrue)
3210 IF How% = 1 THEN
YY$ = CHR$(205) + " To: " + MsgTo$ + " " + STRING$(3, CHR$(205)) + " Subject: " + MsgSubj$ + " " + STRING$(3, CHR$(205))
InsOvwPosition = LEN(YY$)
IF InsertMode THEN
YY$ = YY$ + " Insert " + STRING$(3, CHR$(205))
ELSE
YY$ = YY$ + " Overwrite "
END IF
YY$ = YY$ + STRING$(79 - LEN(YY$), CHR$(205))
I = 1
CALL MoveCursor(2, I)
CALL PutScreen(YY$, WhiteFore, ZFalse)
END IF
END SUB
SUB UpdtCalr (YY$, Z) STATIC
END SUB